home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Developer Essentials / MPW Interfaces & Libraries / AIncludes / ObjMacros.a < prev    next >
Encoding:
Text File  |  1992-01-29  |  13.1 KB  |  491 lines  |  [TEXT/MPS ]
  1. ; Version: 3.04
  2. ; Created: Friday, October 20, 1989 at 9:32:41 PM
  3. ;
  4. ; File: ObjMacros.a
  5. ;
  6. ; Assembler Interface to the Macintosh Libraries
  7. ; Copyright Apple Computer, Inc. 1986-1991
  8. ; All Rights Reserved.
  9. ;
  10. ;--------------------------------------------------------------------
  11. ; This file contains:
  12. ; Macros to support Object Assembler
  13. ; The InitObjects macro
  14. ; A template for TObject, the suggested root class for all objects
  15. ;
  16. ; The usable Macros in this file are documented in both the Assembler
  17. ; and MacApp manuals. Those macros are:
  18. ;
  19. ; ObjectDef
  20. ; ObjectIntf
  21. ; ObjectWith
  22. ; EndObjectWith
  23. ; ProcMethOf
  24. ; FuncMethOf
  25. ; EndMethod
  26. ; MethCall
  27. ; Inherited
  28. ; MoveSelf
  29. ; NewObject
  30. ; InitObjects
  31. ;
  32. ;
  33. ; Current limitations:
  34. ; 250 classes
  35. ; unlimited methods
  36. ;
  37. ; Object assembler programmers who do not use a Pascal main program
  38. ; MUST call the InitObjects macro at the beginning of their program.
  39. ;--------------------------------------------------------------------
  40. ;
  41. ; Modification history:
  42. ; *** MPW 2.0 ***
  43. ;--------------------------------------------------------------------
  44.  
  45.     IF &TYPE('__IncludingObjMacros__') = 'UNDEFINED' THEN
  46. __IncludingObjMacros__    SET    1
  47.  
  48.  
  49.                   IMPORT      %_METHOD
  50.                   IMPORT      %_OBNEW
  51.                   IF          &TYPE('ObjOptFlag') = 'UNDEFINED' THEN
  52. ObjOptFlag:       EQU         0
  53.                   ENDIF
  54.                   IF          &TYPE('DebugFlag') = 'UNDEFINED' THEN
  55. DebugFlag:        EQU         1
  56.                   ENDIF
  57.  
  58.  
  59.                   MACRO
  60.                   REFSELECTOR &ProcName,&ItsObjIndex,&OpCode
  61.  
  62.                   GBLA        &ObjSupers[250],&MethLists[250], &MethTable
  63.                   GBLC        &ObjNames[250]
  64.  
  65.                   LCLA        &start,&found,&objIndex,&LexInt
  66.  
  67.                   &found:     SETA 0
  68.                   IF          &FINDSYM(&MethTable,&ProcName) THEN
  69.                   &start:     SETA 1
  70.                   GOTO        .EndLoop
  71.                   WHILE       &SYSTOKEN <> 30 DO
  72.                   &LexInt:    SETA &S2I(&SYSTOKSTR)
  73.                   &objIndex:  SETA &ItsObjIndex
  74.                   WHILE       (&objIndex <> 0) DO
  75.                   IF          &LexInt = &objIndex THEN
  76.                   &OpCode     &ObjNames[&objIndex]$&ProcName
  77.                   &objIndex:  SETA 0
  78.                   &found:     SETA 1
  79.                   ELSE
  80.                   &objIndex:  SETA &ObjSupers[&objIndex]
  81.                   ENDIF
  82.                   ENDWHILE
  83. .EndLoop
  84.                   &start:     SETA &LEX(&SYSVALUE, &start)
  85.                   WHILE       (&SYSTOKEN <> 1) AND (&SYSTOKEN <> 30) DO
  86.                   &start:     SETA &LEX(&SYSVALUE, &start)
  87.                   ENDWHILE
  88.                   ENDWHILE
  89.                   ENDIF
  90.  
  91.                   IF          &found = 0 THEN
  92.                   AERROR      &Concat('Error trying to reference method: ',&ProcName)
  93.                   ENDIF
  94.  
  95.                   ENDMACRO
  96.  
  97.                   MACRO
  98.                   SELECTORPROC &ProcName
  99.                   LCLC        &SaveSeg
  100.                   &SaveSeg:   SETC &SYSSEG
  101.                   SEG         '%_SelProcs'
  102.                   &ProcName:  PROC EXPORT
  103.                   JSR         %_METHOD
  104.                   ENDPROC
  105.                   SEG         '&SaveSeg'
  106.                   ENDMACRO
  107.  
  108.  
  109.  
  110.                   MACRO
  111.                   ObjectTemplate &TypeName,&Heritage=NIL,&IntfOnly:INT=0
  112.  
  113.                   GBLA        &ObjSupers[250],&MethLists[250]
  114.                   GBLC        &ObjNames[250]
  115.                   GBLA        &lastObjIndex, &currMethIndex, &MethTable
  116.  
  117.                   GBLA        &NumFields,&NumMethods
  118.                   GBLC        &FieldList[250],&MethodList[250]
  119.  
  120.                   LCLA        &methNum, &fieldNum, &objIndex
  121.                   LCLC        &SaveSeg, &RootIndex
  122.                   LCLA        &SuperIndex, &NumChars, &Temp
  123.                   LCLA        &methIndex, &foundIndex, &MethFlag, &SymReturn
  124.  
  125.                   LCLC        &TempArray[1],&CurrField[2],&CurrMethod[3]
  126.  
  127.                   IF          &MethTable = 0 THEN
  128.                   &MethTable: SETA &NEWSYMTBL
  129.                   ENDIF
  130.  
  131.                   &lastObjIndex: SETA &lastObjIndex+1
  132.                   &ObjNames[&lastObjIndex]: SETC &TypeName
  133.                   &MethLists[&lastObjIndex]: SETA &currMethIndex+1
  134.                   IF          (&Heritage = 'NIL') THEN
  135.                   &ObjSupers[&lastObjIndex]: SETA 0
  136.                   ELSE
  137.                   &SuperIndex: SETA 1
  138.                   &ObjNames[&lastObjIndex+1]: SETC &Heritage
  139.                   WHILE       (&ObjNames[&SuperIndex] <> &Heritage) DO
  140.                   &SuperIndex: SETA &SuperIndex+1
  141.                   ENDWHILE
  142.                   IF          (&SuperIndex > &lastObjIndex) THEN
  143.                   AERROR      &Concat('Non-existent Ancestor Object Type: ',&Heritage)
  144.                   ELSE
  145.                   &ObjSupers[&lastObjIndex]: SETA &SuperIndex
  146.                   ENDIF
  147.                   ENDIF
  148.  
  149.                   IF          &NumFields >= 0 THEN
  150.                   &fieldNum:  SETA 1
  151.                   %&TypeName: RECORD &Heritage.Offset
  152.                   WHILE       &fieldNum <= &NumFields DO
  153.                   &NumChars:  SETA &LEN(&FieldList[&fieldNum])-2
  154.                   &Temp:      SETA &LIST(&FieldList[&fieldNum,2:&NumChars], '&CurrField')
  155.                   IF          &Eval(&CurrField[2]) >= 2 THEN
  156.                   ALIGN       2
  157.                   ENDIF
  158.                   &CurrField[1]: DS.B &CurrField[2]
  159.                   &fieldNum:  SETA &fieldNum+1
  160.                   ENDWHILE
  161.                   ALIGN       2
  162.                   last:       EQU *
  163.                   ENDR
  164.                   &TypeName.Offset: EQU %&TypeName..last
  165.                   ENDIF
  166.  
  167.                   IF          &NumMethods > 0 THEN
  168.                   &methNum:   SETA 1
  169.                   WHILE       &methNum <= &NumMethods DO
  170.                   &NumChars:  SETA &LEN(&MethodList[&methNum])-2
  171.                   &CurrMethod[2]: SETC ''
  172.                   &CurrMethod[3]: SETC ''
  173.                   &Temp:      SETA &LIST(&MethodList[&methNum,2:&NumChars], '&CurrMethod')
  174.                   IF          (&CurrMethod[2] = '') OR (&UC(&CurrMethod[2]) = 'IMPL') THEN
  175.                   IF          (&UC(&CurrMethod[2]) = 'IMPL') THEN
  176.                   IF          &IntfOnly THEN
  177.                   IMPORT      &TypeName.$&CurrMethod[1]
  178.                   ELSE
  179.                   AERROR      &Concat('IMPL only allowed in ObjectIntf Macro. Error at ', \
  180.                   &CurrMethod[1],' in ',&TypeName)
  181.                   ENDIF
  182.                   ELSEIF      &IntfOnly THEN
  183.                   IMPORT      &TypeName.$&CurrMethod[1]
  184.                   ELSE
  185.                   SELECTORPROC &TypeName.$&CurrMethod[1]
  186.                   ENDIF
  187.                   &currMethIndex: SETA &currMethIndex+1
  188.                   &SymReturn: SETA &ENTERSYM(&MethTable,&I2S(&currMethIndex),&CurrMethod[1],0)
  189.  
  190. *                 First       do findsym to see if other unrelated root classes
  191.                   IF          &FINDSYM(&MethTable,&CurrMethod[1]) THEN
  192.                   &RootIndex: SETC &Concat(&SYSVALUE,' ',&I2S(&lastObjIndex))
  193.                   &MethFlag:  SETA &SYSFLAGS+1
  194.                   ELSE
  195.                   &RootIndex: SETC &I2S(&lastObjIndex)
  196.                   &MethFlag:  SETA 1
  197.                   ENDIF
  198.                   &SymReturn: SETA &ENTERSYM(&MethTable,&CurrMethod[1],&RootIndex,&MethFlag)
  199.                   ELSEIF      (&UC(&CurrMethod[2]) <> 'OVERRIDE') THEN
  200.                   AERROR      &Concat(&CurrMethod[2],' illegal after ',&CurrMethod[1], \
  201.                   '           in ',&TypeName)
  202.                   ENDIF
  203.                   IF          NOT &IntfOnly THEN
  204.                   EXPORT      &TypeName._&CurrMethod[1]
  205.                   ELSEIF      (&UC(&CurrMethod[2]) = 'IMPL') OR (&UC(&CurrMethod[3]) = 'IMPL') THEN
  206.                   EXPORT      &TypeName._&CurrMethod[1]
  207.                   ELSE
  208.                   IMPORT      &TypeName._&CurrMethod[1]
  209.                   ENDIF
  210.                   &methNum:   SETA &methNum+1
  211.                   ENDWHILE
  212.  
  213.                   IF          NOT &IntfOnly THEN
  214.                   &SaveSeg:   SETC &SYSSEG
  215.                   SEG         '%_MethTables'
  216.                   CODEREFS    FORCEJT
  217.                   _&TypeName: PROC EXPORT
  218.                   DC.W        _&TypeName
  219.                   IF          &Heritage = 'NIL' THEN
  220.                   DC.W        0
  221.                   ELSE
  222.                   DC.W        _&Heritage
  223.                   ENDIF
  224.                   DC.W        &TypeName.Offset
  225.                   DC.W        &methNum-1
  226.                   &methNum:   SETA 1
  227.                   WHILE       &methNum <= &NumMethods DO
  228.                   &NumChars:  SETA &LEN(&MethodList[&methNum])-2
  229.                   &CurrMethod[2]: SETC ''
  230.                   &CurrMethod[3]: SETC ''
  231.                   &Temp:      SETA &LIST(&MethodList[&methNum,2:&NumChars], '&CurrMethod')
  232.                   IF          (&CurrMethod[2] = '') THEN
  233.                   DC.W        &TypeName.$&CurrMethod[1]
  234.                   ELSEIF      (&UC(&CurrMethod[2]) = 'OVERRIDE') THEN
  235.                   IF          &superIndex = 0 THEN
  236.                   AERROR      &Concat('Override of Non-existent method: ',&CurrMethod[1])
  237.                   ELSE
  238.                   REFSELECTOR &CurrMethod[1],&superIndex,DC.W
  239.                   ENDIF
  240.                   ENDIF
  241.                   IMPORT      &TypeName._&CurrMethod[1]
  242.                   DC.W        &TypeName._&CurrMethod[1]
  243.                   &methNum:   SETA &methNum+1
  244.                   ENDWHILE
  245.                   ENDPROC
  246.                   SEG         '&SaveSeg'
  247.                   CODEREFS    NOFORCEJT
  248.                   ELSE
  249.                   IMPORT      _&TypeName
  250.                   ENDIF
  251.                   ENDIF
  252.                   &MethLists[&lastObjIndex+1]: SETA &currMethIndex+1
  253.                   ENDMACRO
  254.  
  255.  
  256.                   MACRO
  257.                   ObjectDef   &TypeName,&Heritage=NIL
  258.  
  259.                   GBLA        &NumFields,&NumMethods
  260.                   GBLC        &FieldList[250],&MethodList[250]
  261.  
  262.                   LCLA        &index1, &index2
  263.  
  264.                   &index1:    SETA 3
  265.                   &index2:    SETA 1
  266.                   WHILE       &NBR(&SYSLIST[&index1]) <> 0 DO
  267.                   &FieldList[&index2]: SETC &SYSLIST[&index1]
  268.                   &index1:    SETA &index1+1
  269.                   &index2:    SETA &index2+1
  270.                   ENDWHILE
  271.                   &NumFields: SETA &index2-1
  272.  
  273.                   &index2:    SETA 1
  274.                   IF          &SYSLIST[&index1] = 'METHODS' THEN
  275.                   &index1:    SETA &index1+1
  276.                   WHILE       &NBR(&SYSLIST[&index1]) <> 0 DO
  277.                   &MethodList[&index2]: SETC &SYSLIST[&index1]
  278.                   &index1:    SETA &index1+1
  279.                   &index2:    SETA &index2+1
  280.                   ENDWHILE
  281.                   ENDIF
  282.                   &NumMethods: SETA &index2-1
  283.  
  284.                   ObjectTemplate &TypeName,&Heritage,0
  285.                   ENDMACRO
  286.  
  287.  
  288.                   MACRO
  289.                   ObjectIntf  &TypeName,&Heritage=NIL
  290.  
  291.                   GBLA        &NumFields,&NumMethods
  292.                   GBLC        &FieldList[250],&MethodList[250]
  293.  
  294.                   LCLA        &index1, &index2
  295.  
  296.                   &index1:    SETA 3
  297.                   &index2:    SETA 1
  298.                   WHILE       &NBR(&SYSLIST[&index1]) <> 0 DO
  299.                   &FieldList[&index2]: SETC &SYSLIST[&index1]
  300.                   &index1:    SETA &index1+1
  301.                   &index2:    SETA &index2+1
  302.                   ENDWHILE
  303.                   &NumFields: SETA &index2-1
  304.  
  305.                   &index2:    SETA 1
  306.                   IF          &SYSLIST[&index1] = 'METHODS' THEN
  307.                   &index1:    SETA &index1+1
  308.                   WHILE       &NBR(&SYSLIST[&index1]) <> 0 DO
  309.                   &MethodList[&index2]: SETC &SYSLIST[&index1]
  310.                   &index1:    SETA &index1+1
  311.                   &index2:    SETA &index2+1
  312.                   ENDWHILE
  313.                   ENDIF
  314.                   &NumMethods: SETA &index2-1
  315.  
  316.                   ObjectTemplate &TypeName,&Heritage,1
  317.                   ENDMACRO
  318.  
  319.  
  320.  
  321.                   MACRO
  322.                   OBJECTWITH  &TypeName
  323.                   GBLA        &WithLevel[8]
  324.                   GBLA        &WithIndex
  325.                   GBLA        &ObjSupers[*]
  326.                   GBLC        &ObjNames[*]
  327.                   GBLA        &lastObjIndex
  328.  
  329.                   GBLC        &currObjName,&currSuperName
  330.                   GBLA        &currObjIndex
  331.  
  332.                   LCLA        &SuperIndex
  333.                   &currObjName: SETC &TypeName
  334.                   &SuperIndex: SETA 1
  335.                   &ObjNames[&lastObjIndex+1]: SETC &TypeName
  336.                   WHILE       &ObjNames[&SuperIndex] <> &TypeName DO
  337.                   &SuperIndex: SETA &SuperIndex+1
  338.                   ENDWHILE
  339.                   &currObjIndex: SETA &SuperIndex
  340.                   IF          &SuperIndex > &lastObjIndex THEN
  341.                   AERROR      &Concat('Object Type name does not exist: ',&TypeName)
  342.                   ELSE
  343.                   IF          &ObjSupers[&SuperIndex] = 0 THEN
  344.                   &currSuperName: SETC 'NIL'
  345.                   ELSE
  346.                   &currSuperName: SETC &ObjNames[&ObjSupers[&SuperIndex]]
  347.                   ENDIF
  348.                   WITH        %&TypeName
  349.                   &WithIndex: SETA &WithIndex+1
  350.                   WHILE       &ObjSupers[&SuperIndex] <> 0 DO
  351.                   WITH        %&ObjNames[&ObjSupers[&SuperIndex]]
  352.                   &WithLevel[&WithIndex]: SETA &WithLevel[&WithIndex]+1
  353.                   &SuperIndex: SETA &ObjSupers[&SuperIndex]
  354.                   ENDWHILE
  355.                   ENDIF
  356.                   ENDMACRO
  357.  
  358.                   MACRO
  359.                   METHOD      &MethName,&TypeName,&FuncORProc=PROC
  360.                   &TypeName._&MethName: &FuncORProc EXPORT
  361.                   OBJECTWITH  &TypeName
  362.                   ENDMACRO
  363.  
  364.                   MACRO
  365.                   &MethName:  ProcMethOf &TypeName
  366.                   METHOD      &MethName,&TypeName,PROC
  367.                   ENDMACRO
  368.  
  369.                   MACRO
  370.                   &MethName:  FuncMethOf &TypeName
  371.                   METHOD      &MethName,&TypeName,FUNC
  372.                   ENDMACRO
  373.  
  374.                   MACRO
  375.                   ObjectEndWith
  376.                   ENDWITH
  377.                   GBLA        &WithLevel[*]
  378.                   GBLA        &WithIndex
  379.                   IF          &WithIndex > 0 THEN
  380.                   WHILE       &WithLevel[&WithIndex] > 0 DO
  381.                   ENDWITH
  382.                   &WithLevel[&WithIndex]: SETA &WithLevel[&WithIndex]-1
  383.                   ENDWHILE
  384.                   &WithIndex: SETA &WithIndex-1
  385.                   ENDIF
  386.                   ENDMACRO
  387.  
  388.  
  389.                   MACRO
  390.                   ENDMETHOD
  391.                   ObjectEndWith
  392.                   ENDPROC
  393.                   ENDMACRO
  394.  
  395.  
  396.                   MACRO
  397.                   METHCALL    &MethName,&ObjTypeName
  398.                   GBLC        &ObjNames[*]
  399.                   GBLA        &currObjIndex, &lastObjIndex
  400.  
  401.                   LCLA        &objIndex
  402.                   IF          &ObjTypeName = '' THEN
  403.                   &objIndex:  SETA &currObjIndex
  404.                   ELSE
  405.                   &objIndex:  SETA 1
  406.                   &ObjNames[&lastObjIndex+1]: SETC &ObjTypeName
  407.                   WHILE       &ObjNames[&objIndex] <> &ObjTypeName DO
  408.                   &objIndex:  SETA &objIndex+1
  409.                   ENDWHILE
  410.                   ENDIF
  411.                   IF          &objIndex > &lastObjIndex THEN
  412.                   AERROR      &Concat('Unknown Object type Name: ',&ObjTypeName)
  413.                   ELSEIF      ObjOptFlag THEN
  414.                   JSR         &ObjNames[&objIndex]$&MethName
  415.                   ELSE
  416.                   REFSELECTOR &MethName,&objIndex,JSR
  417.                   ENDIF
  418.                   ENDMACRO
  419.  
  420.                   MACRO
  421.                   INHERITED   &MethName
  422.                   GBLC        &ObjNames[*]
  423.                   GBLA        &ObjSupers[*]
  424.                   GBLA        &currObjIndex
  425.  
  426.                   LCLA        &objIndex
  427.  
  428.                   &objIndex:  SETA &ObjSupers[&currObjIndex]
  429.                   WHILE       (&TYPE(&Concat(&ObjNames[&objIndex],'_',&MethName)) = 'UNDEFINED') AND (&objIndex <> 0) DO
  430.                   &objIndex:  SETA &ObjSupers[&objIndex]
  431.                   ENDWHILE
  432.                   IF          &objIndex = 0 THEN
  433.                 AERROR &Concat('Inherited error; Method not defined in ancestor: ',&MethName)
  434.                   ELSE
  435.                   IMPORT      &ObjNames[&objIndex]_&MethName
  436.                   JSR         &ObjNames[&objIndex]_&MethName
  437.                   ENDIF
  438.                   ENDMACRO
  439.  
  440.  
  441.                   MACRO
  442.                   MoveSelf    &Dest
  443.                   MOVE.L      8(A6),&Dest
  444.                   ENDMACRO
  445.  
  446.  
  447.                   MACRO
  448.                   NewObject   &Loc,&TypeName,&Size
  449.                   PEA         &Loc
  450.                   PEA         _&TypeName+2
  451.                   IF          &Size = '' THEN
  452.                   MOVE.W      #&TypeName.Offset,-(SP)
  453.                   ELSE
  454.                   MOVE.W      #&Size,-(SP)
  455.                   ENDIF
  456.                   JSR         %_OBNEW
  457.                   ENDMACRO
  458. *                 The         InitObjects macro must be called if the main program is not in Pascal
  459.  
  460.                   IMPORT      %_PGM1
  461.  
  462.                   MACRO
  463.                   InitObjects
  464.  
  465.                   JSR         %_PGM1
  466.                   ENDMACRO
  467.  
  468.  
  469. NILOffset         EQU         2
  470.  
  471.                   IF          DebugFlag THEN
  472.  
  473.                   ObjectIntf  TObject,, \ Suggested root class for all objects
  474.                   METHODS,    \ no data fields
  475.                 (ShallowClone), \ Object copying method; rarely overridden
  476.                 (Clone), \ Can be overriden to clone fields
  477.                 (ShallowFree), \ Frees object; rarely overridden
  478.                   (Free),     \ Can be overriden to free fields
  479.                   (ClassName), \ Returns name of class
  480.                   (Inspect)                             ; Print info to debug window
  481.                   ELSE
  482.                   ObjectIntf  TObject,, \ Suggested root class for all objects
  483.                   METHODS,    \ no data fields
  484.                 (ShallowClone), \ Object copying method; rarely overridden
  485.                 (Clone), \ Can be overriden to clone fields
  486.                 (ShallowFree), \ Frees object; rarely overridden
  487.                 (Free) ; Can be overriden to free fields
  488.                 
  489.                 ENDIF
  490.  
  491.     ENDIF    ; ...already included